home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / Billiards / graph.p < prev    next >
Encoding:
Text File  |  1996-09-29  |  3.4 KB  |  154 lines  |  [TEXT/Rich]
  1. { graphical simulation class }
  2. { written by Tim Budd, Oregon State University }
  3. { April 1990 }
  4.  
  5. unit graphicUniverse;
  6.  
  7. interface
  8.  
  9.     type
  10.  
  11.         GraphicalObject = object
  12.                 link: GraphicalObject;
  13.                 region: Rect;
  14.                 procedure moveTo (x, y: integer);
  15.                 function intersectsWith (anObject: GraphicalObject): boolean;
  16.                 procedure erase;
  17.                     { the following overridden in subclasses }
  18.                 procedure update;
  19.                 procedure draw;
  20.                 procedure hitBy (anObject: GraphicalObject);
  21.             end;
  22.  
  23.         ObjectUniverse = object
  24.                 moveableObjects: GraphicalObject;
  25.                 fixedObjects: GraphicalObject;
  26.                 continueUpdate: boolean;
  27.                 procedure initialize;
  28.                 procedure installFixedObject (newObj: GraphicalObject);
  29.                 procedure installMovableObject (newObj: GraphicalObject);
  30.                 procedure draw;
  31.                 procedure updateMoveableObjects;
  32.                 procedure continueSimulation;
  33.                 function hitObject (anObject: GraphicalObject):GraphicalObject;
  34.             end;
  35.  
  36. implementation
  37.  
  38.     procedure GraphicalObject.moveTo (x, y: integer);
  39.     begin
  40.         OffsetRect(region, region.top, region.left);
  41.         OffsetRect(region, x, y);
  42.     end;
  43.  
  44.     procedure GraphicalObject.update;
  45.     begin
  46.         { implemented in subclass }
  47.     end;
  48.  
  49.     procedure GraphicalObject.erase;
  50.     begin
  51.         EraseRect(region);
  52.     end;
  53.  
  54.     procedure GraphicalObject.draw;
  55.     begin
  56.         { implemented in subclass }
  57.     end;
  58.  
  59.     function GraphicalObject.intersectsWith (anObject: GraphicalObject): 
  60.                 boolean;
  61.         var
  62.             theIntersection: Rect;
  63.     begin
  64.         intersectsWith := SectRect(region, anObject.region, theIntersection);
  65.     end;
  66.  
  67.     procedure GraphicalObject.hitBy (anObject: GraphicalObject);
  68.     begin
  69.         { behavior provided by subclass }
  70.     end;
  71.  
  72.     procedure ObjectUniverse.initialize;
  73.     begin
  74.         fixedObjects := nil;
  75.         moveableObjects := nil;
  76.     end;
  77.  
  78.     procedure ObjectUniverse.installFixedObject (newObj: GraphicalObject);
  79.     begin
  80.         newObj.link := fixedObjects;
  81.         fixedObjects := newObj;
  82.     end;
  83.  
  84.     procedure ObjectUniverse.installMovableObject;
  85.     begin
  86.         newObj.link := moveableObjects;
  87.         moveableObjects := newObj;
  88.     end;
  89.  
  90.     procedure ObjectUniverse.updateMoveableObjects;
  91.         var
  92.             currentObject: GraphicalObject;
  93.     begin
  94.         repeat
  95.             continueUpdate := false;
  96.             currentObject := moveableObjects;
  97.             while currentObject <> nil do
  98.                 begin
  99.                     currentObject.update;
  100.                     currentObject := currentObject.link;
  101.                 end;
  102.         until not continueUpdate
  103.     end;
  104.  
  105.     procedure ObjectUniverse.continueSimulation;
  106.     begin
  107.         continueUpdate := true
  108.     end;
  109.  
  110.     procedure ObjectUniverse.draw;
  111.         var
  112.             currentObject: GraphicalObject;
  113.     begin
  114.         currentObject := fixedObjects;
  115.         while currentObject <> nil do
  116.             begin
  117.                 currentObject.draw;
  118.                 currentObject := currentObject.link;
  119.             end;
  120.         currentObject := moveableObjects;
  121.         while currentObject <> nil do
  122.             begin
  123.                 currentObject.draw;
  124.                 currentObject := currentObject.link;
  125.             end;
  126.     end;
  127.  
  128.     function ObjectUniverse.hitObject (anObject: GraphicalObject): 
  129.                 GraphicalObject;
  130.         var
  131.             currentObject: GraphicalObject;
  132.             hit: GraphicalObject;
  133.     begin
  134.         currentObject := fixedObjects;
  135.         hit := nil;
  136.         while (hit = nil) and (currentObject <> nil) do
  137.             begin
  138.                 if (anObject <> currentObject) then
  139.                     if (anObject.intersectsWith(currentObject)) then
  140.                         hit := currentObject;
  141.                 currentObject := currentObject.link;
  142.             end;
  143.         currentObject := moveableObjects;
  144.         while (hit = nil) and (currentObject <> nil) do
  145.             begin
  146.                 if (anObject <> currentObject) then
  147.                     if (anObject.intersectsWith(currentObject)) then
  148.                         hit := currentObject;
  149.                 currentObject := currentObject.link;
  150.             end;
  151.         hitObject := hit;
  152.     end;
  153. end.
  154.